module Rel1

where 

import SetOrd

type Rel a = Set (a,a)

domR :: Ord a => Rel a -> Set a
domR (Set r) = list2set [ x | (x,_) <- r ]

ranR :: Ord a => Rel a -> Set a
ranR (Set r) = list2set [ y | (_,y) <- r ]

idR :: Ord a => Set a -> Rel a 
--idR (Set []) = (Set []) 
--idR (Set (x:xs)) = insertSet (x,x) (idR (Set xs))
idR (Set xs) = Set [(x,x) | x <- xs]

totalR :: Set a -> Rel a
totalR (Set xs) = Set [(x,y) | x <- xs, y <- xs ]

invR :: Ord a => Rel a -> Rel a
invR (Set []) = (Set [])
invR (Set ((x,y):r)) = insertSet (y,x) (invR (Set r))

inR :: Ord a => Rel a -> (a,a) -> Bool
inR r (x,y) = inSet (x,y) r 

reflR :: Ord a => Set a -> Rel a -> Bool
reflR (Set xs) r = subSet (Set [(x,x) | x <- xs]) r 

irreflR :: Ord a => Set a -> Rel a -> Bool
irreflR (Set xs) r = 
   all (\ pair  -> not (inR r pair)) [(x,x) | x <- xs]

symR :: Ord a => Rel a -> Bool
symR (Set []) = True 
symR (Set ((x,y):pairs)) | x == y = symR (Set pairs)
                         | otherwise = 
                           inSet (y,x) (Set pairs) 
                           && symR (deleteSet (y,x) (Set pairs))

transR :: Ord a => Rel a -> Bool
transR (Set []) = True
transR (Set s) = and [ trans pair (Set s) | pair <- s ] where 
      trans (x,y) (Set r) = 
         and [ inSet (x,v) (Set r) | (u,v) <- r, u == y ] 

composePair :: Ord a => (a,a) -> Rel a -> Rel a
composePair (x,y) (Set []) = Set []
composePair (x,y) (Set ((u,v):s)) 
   | y == u    = insertSet (x,v) (composePair (x,y) (Set s))
   | otherwise = composePair (x,y) (Set s)

unionSet :: (Ord a) => Set a -> Set a -> Set a 
unionSet (Set [])     set2  =  set2
unionSet (Set (x:xs)) set2  = 
   insertSet x (unionSet (Set xs) (deleteSet x set2))

compR :: Ord a => Rel a -> Rel a -> Rel a 
compR (Set []) _ = (Set [])
compR (Set ((x,y):s)) r = 
   unionSet (composePair (x,y) r) (compR (Set s) r) 

repeatR :: Ord a => Rel a -> Int -> Rel a 
repeatR r n | n < 1     = error "argument < 1"
            | n == 1    = r 
            | otherwise = compR r (repeatR r (n-1))

